Loading & Preparing Data
options(scipen=10)
pacman::p_load(latex2exp,Matrix,dplyr,tidyr,ggplot2,caTools,plotly)
rm(list=ls(all=TRUE))
load("data/tf4.rdata")

購買機率與預期營收的分布

par(mfrow=c(1,2), cex=0.8)
hist(B$Buy)
hist(log(B$Rev,10))

B %>% ggplot(aes(x=age,y=Rev)) + 
  geom_boxplot() + scale_y_log10()

#用年紀畫圖
group_by(B,age) %>% 
  summarise(n=n(), Buy=mean(Buy), Rev=mean(Rev)) %>% 
  ggplot(aes(Buy,Rev,size=n,label=age)) + 
  geom_point(alpha=0.5,color='gold') + 
  geom_text(size=4) +
  scale_size(range=c(4,20)) + theme_bw()  -> p
ggplotly(p)
#buy：：平均購買機率；Rev:營收貢獻；泡泡大小：族群人數

帶有「參數」的成本效益函數

定義、畫出效用函數 由於c()是一個常用的R內建功能，以下我們用x代表成本 m為高點,b中間數值,a為低點到高點的距離（mba成本效益參數） \[\Delta P = f(x|m,b,a) = m \cdot Logis(\frac{10(x - b)}{a})\]

DP = function(x,m0,b0,a0) {m0*plogis((10/a0)*(x-b0))}
par(mar=c(4,4,2,1),cex=0.7)
curve(DP(x,m=0.20,b=30,a=40), 0, 60, lwd=2, ylim=c(0, 0.25), #0-60的值可被畫在圖上，a=10-50之間...
      main="F( x | m=0.2, b=30, a=40 )", ylab="delta P")
abline(h=seq(0,0.2,0.05),v=seq(0,60,5),col='lightgrey',lty=2)

期望報償的算法： #利潤(p來店機率,margin毛利）x要扣成本！ \[\hat{R}(x) = \left\{\begin{matrix} \Delta P \cdot M \cdot margin - x & , & P + \Delta P \leq 1\\ (1-P) \cdot M \cdot margin - x & , & else \end{matrix}\right.\]

估計毛利率(margin)

load("../../w14/unit14.final/data/tf0.rdata") #未把資料放進去
#summarise(z0,1-sum(cost)/sum(price)) #看總體
#group_by(z0,age)%%summarise(z0,1-sum(cost)/sum(price)) #看族群
margin = 0.17  # assume margin = 0.17

估計預期報償

m=0.2; b=25; a=40; x=30
dp = pmin(1-B$Buy, DP(x,m,b,a)) #1-B$Buy看其增加機率 #dp??
eR = dp*B$Rev*margin - x
hist(eR,main="預期報償分佈",xlab="預期報償",ylab="顧客數")

🌻 有多少顧客的預期報償大於零？

table(eR>0) #TRUE預期報償大於零
## 
## FALSE  TRUE 
## 21303  7228

🌻 如果我們針對所有顧客做促銷，預期報償將是？

sum(eR) #會虧203881
## [1] -203881

🌻 如果我們針對預期報償大於零顧客做促銷，預期報償將是？

sum(eR[eR>0]) #會賺75883
## [1] 75883.81

市場模擬

單一參數組合
#x為折價卷面額
#eReturn(全部人都給，都是負的)
#eReturn2(x設定面額，value為可以給的人數->思考預期報償效果，預算多少
m=0.2; b=25; a=40; X = seq(10,45,1)

df = sapply(X, function(x) {
  dp = pmin(DP(x,m,b,a),1-B$Buy)
  eR = dp*B$Rev*margin - x
  c(x=x, eReturn=sum(eR), N=sum(eR > 0), eReturn2=sum(eR[eR > 0]))
  }) %>% t %>% data.frame %>% 
  gather('key','value',-x)

df %>% ggplot(aes(x=x, y=value, col=key)) + 
  geom_hline(yintercept=0,linetype='dashed') +
  geom_line(size=1.5,alpha=0.5) + 
  facet_wrap(~key,ncol=1,scales='free_y') + theme_bw()

不同的參數組合
mm=c(0.20, 0.25, 0.15, 0.25)
bb=c(  25,   30,   15,   30)
aa=c(  40,   40,   30,   60) 
X = seq(0,60,2) 
do.call(rbind, lapply(1:length(mm), function(i) data.frame(
  Inst=paste0('Inst',i), Cost=X, 
  Gain=DP(X,mm[i],bb[i],aa[i])
  ))) %>% data.frame %>% 
  ggplot(aes(x=Cost, y=Gain, col=Inst)) +
  geom_line(size=1.5,alpha=0.5) + theme_bw() +
  ggtitle("Prob. Function: f(x|m,b,a)")

#inst不同的工具，有不同的mba
市場模擬：不同的參數組合的比較
X = seq(10, 60, 1) 
df = do.call(rbind, lapply(1:length(mm), function(i) { #1-mm就會啟動function(i)
  sapply(X, function(x) {
    dp = pmin(1-B$Buy, DP(x,mm[i],bb[i],aa[i]))
    eR = dp*B$Rev*margin - x
    c(i=i, x=x, eR.ALL=sum(eR), N=sum(eR>0), eR.SEL=sum(eR[eR > 0]) )
    }) %>% t %>% data.frame
  })) 
#會按照1-4的工具模擬成效出來（有跑出df的資料匡）

df %>% 
  mutate_at(vars(eR.ALL, eR.SEL), function(y) round(y/1000)) %>% 
  gather('key','value',-i,-x) %>% 
  mutate(Instrument = paste0('I',i)) %>%
  ggplot(aes(x=x, y=value, col=Instrument)) + 
  geom_hline(yintercept=0, linetype='dashed', col='blue') +
  geom_line(size=1.5,alpha=0.5) + 
  xlab('工具選項(成本)') + ylab('預期報償(K)') + 
  ggtitle('行銷工具優化','假設行銷工具的效果是其成本的函數') +
    facet_wrap(~key,ncol=1,scales='free_y') + theme_bw() -> p

plotly::ggplotly(p)
#eR.ALL對所有人做行銷（沒啥意義）
#用eR.SEL看
#i2可以獲得最高的期望報償（面額40，期望報償143k，n=8783人）

每一個工具的最佳參數

group_by(df, i) %>% top_n(1,eR.ALL)
## # A tibble: 4 x 5
## # Groups:   i [4]
##       i     x   eR.ALL     N  eR.SEL
##   <dbl> <dbl>    <dbl> <dbl>   <dbl>
## 1     1    31 -200481.  7511  83441.
## 2     2    37 -179567.  8822 132374.
## 3     3    20  -36157. 11235 102930.
## 4     4    10 -246916.     0      0
#找出四項工具最高的eR.ALL值(以群為單位) 
#top_n(1)選擇第一最高的
group_by(df, i) %>% top_n(1,eR.SEL)
## # A tibble: 4 x 5
## # Groups:   i [4]
##       i     x   eR.ALL     N  eR.SEL
##   <dbl> <dbl>    <dbl> <dbl>   <dbl>
## 1     1    34 -217614.  7569  93549.
## 2     2    40 -196943.  8783 143043.
## 3     3    22  -50497. 10880 107149.
## 4     4    43 -307871.  6979 106687.
#找出四項工具最高的eR.SEL值(以群為單位) 
#top_n(1)選擇第一最高的

討論問題

par(cex=0.7, mar=c(2,2,1,2))
table(B$age) %>% barplot


#用在不同人身上，可能m,b,a不太一樣 #年紀越小，有可能b會往右；當年紀越大，b可能在左或是中間值 🗿 討論問題：
  如果上述4組工具參數分別是某折價券對4個不同年齡族群的效果：
    ■ I1 : a24, a29
24,29歲族群使用34的折價卷面額，期望報酬為93549.32     ■ I2 : a34, a39
34,39歲族群40的折價卷面額，期望報酬為143042.80     ■ I3 : a44, a49
44,49歲族群22的折價卷面額，期望報酬為107148.65     ■ I4 : a54, a59, a64, a69
54,59,64,69歲族群43的折價卷面額，期望報酬為106686.88   如果你可以在這4個年齡族群之中選擇行銷對象，你應該如何：
    ■ 選擇行銷對象(N)？
依照預期報償最大來作為選擇依據，來設定折價面額及年齡對象，因此對象為選擇a34, a39的中年人     ■ 設定折價券的面額(x)？
40的折價卷面額     ■ 估計預期報償(eR.SEL)？
期望報酬為143042.80 選擇a34, a39的中年人，因為可以獲得最高的期望報償。可以採取是網路推播折價卷的行銷手法，因為這個年紀的人通常有一定的收入，且對於網路也有一定的使用習慣。